home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d1 / filecat.arc / FMAIN02.INC < prev    next >
Encoding:
Text File  |  1986-05-14  |  25.3 KB  |  825 lines
  1. OVERLAY FUNCTION SelectKeyword : Str15;
  2.   VAR S:Str15;
  3.       I,N:Integer;
  4.       KArray:Array[1..20] of Str15;
  5.       Done,First:Boolean;
  6.       Ch2:Char;
  7.   Begin
  8.     SaveScreen;
  9.     DrawBox(63,79,1,25);
  10.     BigWindow(64,2,78,24);
  11.     If Monitortype=7 then begin
  12.       HideCursor;
  13.       For I:=1 to 23 do begin
  14.         GotoXY(1,I);
  15.         Write(ConstStr(' ',15));
  16.       End;
  17.       RestoreCursor;
  18.     End Else ClrScr;
  19.     HideCursor;
  20.     GotoXY(1,21); Write('<A...Z> Display');
  21.     GotoXY(1,22); Write('<Enter> Select');
  22.     GotoXY(1,23); Write(' <ESC>  Quit');
  23.     Done:=False;
  24.     First:=False;
  25.     FillChar(KArray,SizeOf(KArray),#0);
  26.     ClearKey(KIndex);
  27.     S:='A';
  28.     N:=1;
  29.     SearchKey(KIndex,I,S);
  30.     If OK then KArray[N]:=S;
  31.     If OK then Repeat
  32.       NextKey(KIndex,I,S);
  33.       If NOT OK then NextKey(KIndex,I,S);
  34.       N:=N+1;
  35.       KArray[N]:=S;
  36.     Until N=20;
  37.     For I:=1 to N do begin
  38.       GotoXY(1,I);
  39.       If I=(N div 2) then begin
  40.         TextBackGround(7);
  41.         TextColor(0);
  42.       End Else Lowvideo;
  43.       Write(KArray[I]);ClrEol;
  44.     End;
  45.     Repeat
  46.       Read(Kbd,Ch);
  47.       If Ch in ['a'..'z'] then Ch:=Upcase(Ch);
  48.       Case Ch of
  49.         #27 : If KeyPressed then begin
  50.               Ch:=#0;
  51.               Read(Kbd,Ch2);
  52.               Case Ch2 of
  53.                 #72 : Begin
  54.                         S:=KArray[1];
  55.                         SearchKey(KIndex,I,S);
  56.                         PrevKey(KIndex,I,S);
  57.                         PrevKey(KIndex,I,S);
  58.                         N:=0;
  59.                         Repeat
  60.                           NextKey(KIndex,I,S);
  61.                           If NOT OK then NextKey(KIndex,I,S);
  62.                           N:=N+1;
  63.                           KArray[N]:=S;
  64.                         Until N=20;
  65.                       End;
  66.                 #80 : Begin
  67.                         S:=KArray[1];
  68.                         SearchKey(KIndex,I,S);
  69.                         N:=0;
  70.                         Repeat
  71.                           NextKey(KIndex,I,S);
  72.                           If NOT OK then NextKey(KIndex,I,S);
  73.                           N:=N+1;
  74.                           KArray[N]:=S;
  75.                         Until N=20;
  76.                       End;
  77.                 #73 : Begin
  78.                         S:=KArray[1];
  79.                         SearchKey(KIndex,I,S);
  80.                         For I:=1 to 21 do PrevKey(KIndex,I,S);
  81.                         N:=0;
  82.                         Repeat
  83.                           NextKey(KIndex,I,S);
  84.                           If NOT OK then NextKey(KIndex,I,S);
  85.                           N:=N+1;
  86.                           KArray[N]:=S;
  87.                         Until N=20;
  88.                       End;
  89.                 #81 : Begin
  90.                         S:=KArray[20];
  91.                         SearchKey(KIndex,I,S);
  92.                         N:=0;
  93.                         Repeat
  94.                           NextKey(KIndex,I,S);
  95.                           If NOT OK then NextKey(KIndex,I,S);
  96.                           N:=N+1;
  97.                           KArray[N]:=S;
  98.                         Until N=20;
  99.                       End;
  100.               End;
  101.               End;
  102.         ' '..'Z' : Begin
  103.                      FillChar(KArray,SizeOf(KArray),#0);
  104.                      ClearKey(KIndex);
  105.                      S:=Ch;
  106.                      N:=1;
  107.                      SearchKey(KIndex,I,S);
  108.                      If OK then KArray[N]:=S;
  109.                      If OK then Repeat
  110.                        NextKey(KIndex,I,S);
  111.                        If NOT OK then NextKey(KIndex,I,S);
  112.                        N:=N+1;
  113.                        KArray[N]:=S;
  114.                      Until N=20;
  115.                    End;
  116.       End;
  117.       For I:=1 to N do begin
  118.         GotoXY(1,I);
  119.         If I=(N div 2) then begin
  120.           TextBackGround(7);
  121.           TextColor(0);
  122.         End Else Lowvideo;
  123.         Write(KArray[I]);ClrEol;
  124.       End;
  125.     Until Ch in [#27,#13];
  126.     If Ch=#27 then SelectKeyword:='' Else SelectKeyword:=KArray[N div 2];
  127.     BigWindow(1,1,80,25);
  128.     RestoreCursor;
  129.     RestoreScreen;
  130.   End; { function SelectKeyword }
  131.  
  132. OVERLAY PROCEDURE AddKeywords;
  133.   VAR S1,S2:AnyStr;
  134.       S3:Str15;
  135.       I:Integer;
  136.   Begin
  137.     S1:=FTemp.Keys;
  138.     I:=1;
  139.     Repeat
  140.       Parse(S1,S2);
  141.       If S2<>'' then begin
  142.         S3:=S2;
  143.         FindKey(KIndex,I,S3);
  144.         If NOT OK then AddKey(KIndex,I,S3);
  145.       End;
  146.     Until S1='';
  147.   End; { procedure AddKeywords }
  148.  
  149. OVERLAY PROCEDURE DeleteTransfer;
  150.   VAR S:AnyStr;
  151.   Begin
  152.     S:=EntryDirectory;
  153.     If S[Length(S)]<>'\' then S:=S+'\';
  154.     S:=S+'TRANSFER.DAT';
  155.     If Exist(S) then begin
  156.       Assign(ExFile,S);
  157.       Erase(ExFile);
  158.       S:=EntryDirectory;
  159.       If S[Length(S)]<>'\' then S:=S+'\';
  160.       S:=S+'TRANSFER.IXN';
  161.       Assign(ExFile,S);
  162.       Erase(ExFile);
  163.     End;
  164.   End; { procedure DeleteTransfer }
  165.  
  166. OVERLAY PROCEDURE AddTransfer(Location:Str80);
  167.   VAR N,RecNum:Integer;
  168.   Begin
  169.     ChDir(EntryDirectory);
  170. (*******
  171.     If Exist('TRANSFER.DAT') then begin
  172.       Assign(ExFile,'TRANSFER.DAT');
  173.       Erase(ExFile);
  174.     End;
  175.     If Exist('TRANSFER.DXT') then begin
  176.       Assign(ExFile,'TRANSFER.DXT');
  177.       Erase(ExFile);
  178.     End;
  179. *******)
  180.     OpenFile(CFile,'FILECAT.DAT',SizeOf(FRec));
  181.     OpenIndex(CIndex,'FILECAT.IXN',14,1);
  182.     Location:=Location+'TRANSFER.DAT';
  183.     OpenFile(CFile2,Location,SizeOf(FRec));
  184.     For N := 1 to FileLen(CFile2)-1 do begin
  185.       GetRec(CFile2,N,FTemp);
  186.       If FTemp.Status=0 then begin
  187.         FKey:=Copy(FTemp.FileName,1,8)+Copy(FTemp.FileName,10,3);
  188.         FKey:=FKey+ConstStr(' ',13-Length(FKey));
  189.         If FTemp.StandAlone then FKey:=FKey+'1' Else FKey:=FKey+'0';
  190.         GotoXY(1,11);ClrEol;
  191.         Write('Adding ',FKey);
  192.         AddRec(CFile,RecNum,FTemp);
  193.         If OK then AddKey(CIndex,RecNum,FKey);
  194.         If NOT OK then begin
  195.           DeleteRec(CFile,RecNum);
  196.           GotoXY(1,11);ClrEol;
  197.           Beep;
  198.           Write('Error writing Record');
  199.         End;
  200.       End;
  201.     End;
  202.     GotoXY(1,11); ClrEol;
  203.     CloseFile(CFile);
  204.     CloseIndex(CIndex);
  205.     CloseFile(CFile2);
  206.   End; { procedure AddTransfer }
  207.  
  208. OVERLAY PROCEDURE MoveFiles;
  209.   VAR N,RecNum:Integer;
  210.       S:Str80;
  211.   Begin
  212.     ChDir(EntryDirectory);
  213.     OpenFile(CFile,'TRANSFER.DAT',SizeOf(FRec));
  214.     S:=SourceDirectory;
  215.     N:=Length(S);
  216.     If S[N]<>'\'then S:=S+'\';
  217.     S:=S+'TRANSFER.DAT';
  218.     MakeFile(CFile2,S,SizeOf(FRec));
  219.     CloseFile(CFile2);
  220.     OpenFile(CFile2,S,SizeOf(FRec));
  221.     For N := 1 to FileLen(CFile)-1 do begin
  222.       GetRec(CFile,N,FTemp);
  223.       If FTemp.Status=0 then begin
  224.         GotoXY(29,24);
  225.         Write('Adding ',FTemp.FileName);
  226.         AddRec(CFile2,RecNum,FTemp);
  227.       End;
  228.     End;
  229.     GotoXY(1,24); ClrEol;
  230.     CloseFile(CFile);
  231.     CloseFile(CFile2);
  232.   End; { procedure MoveFiles }
  233.  
  234. OVERLAY PROCEDURE SetEpson;
  235.   CONST N = 26;
  236.   VAR TempCh :Char;
  237.       Left,I : Integer;
  238.       S:AnyStr;
  239.   Begin
  240.     If Monitortype=7 then begin
  241.       For I:=7 to 25 do begin
  242.         GotoXY(1,I);
  243.         ClrEol;
  244.       End;
  245.     End Else begin
  246.       BigWindow(1,7,80,25);
  247.       ClrScr;
  248.       BigWindow(1,1,80,25);
  249.     End;
  250.     If not PrTest then Repeat
  251.       Beep;
  252.       GotoXY(20,15);
  253.       WriteLn('Printer does not appear to be ready');
  254.       GotoXY(20,16);
  255.       WriteLn('Press any key when ready or ESC to return to menu');
  256.       Repeat until KeyPressed;
  257.       Read(Kbd,TempCh);
  258.       If (TempCh = #27) and KeyPressed then Read(Kbd,TempCh);
  259.       If TempCh = #27 then Exit;
  260.       If Monitortype=7 then begin
  261.         For I:=9 to 25 do begin
  262.           GotoXY(1,I);
  263.           ClrEol;
  264.         End;
  265.       End Else begin
  266.         BigWindow(1,9,80,25);
  267.         ClrScr;
  268.         BigWindow(1,1,80,25);
  269.       End;
  270.     Until PrTest;
  271.     GotoXY(N,10); WriteLn('1 -- Pica  (10 chars/inch)');
  272.     GotoXY(N,11); WriteLn('2 -- Elite (12 chars/inch)');
  273.     GotoXY(N,12); WriteLn('3 -- Cond  (17 chars/inch)');
  274.     GotoXY(N,13); WriteLn('4 -- Set Left Margin');
  275.     LowVideo;
  276.     GotoXY(N,16); WriteLn('9 -- Return to Main Menu');
  277.     NormVideo;
  278.     GotoXY(N,21); Write('Enter your selection: [ ]');
  279.     Left:=1;
  280.     TempCh:='1';
  281.     Write(Lst,#27,'@',#13);
  282.     Write(Lst,#27,'l',Chr(Left),#13);
  283.     Repeat
  284.       GotoXY(N,23);ClrEol;
  285.       Write('Left Margin set at ',Left,'  ');
  286.       Case TempCh of
  287.         '1' : Write('Pica');
  288.         '2' : Write('Elite');
  289.         '3' : Write('Condensed');
  290.       End;
  291.       GotoXY(N+23,21);
  292.       Read(Kbd,TempCh);
  293.       Write(TempCh);
  294.       Case TempCh of
  295.         '1' : Write(Lst,#27,#18,#27,'P',#13);
  296.         '2' : Write(Lst,#27,#18,#27,'M',#13);
  297.         '3' : Write(Lst,#27,'P',#27,#15,#13);
  298.         '4' : Begin
  299.                 Repeat
  300.                   GotoXY(N,23);ClrEol;
  301.                   Write('Set left margin at how many characters: ');
  302.                   ReadLn(S);
  303.                   Val(S,Left,I);
  304.                   If (Left<0) or (Left>20) then I:=1;
  305.                   If I<>0 then Boop;
  306.                 Until I=0;
  307.                 Write(Lst,#27,'l',Chr(Left),#13);
  308.               End;
  309.         '9' : ;
  310.       Else Boop;
  311.       End;
  312.     Until TempCh = '9';
  313.   End; {SetEpson}
  314.  
  315. OVERLAY FUNCTION SelectFile: Integer;
  316.   VAR TopLine,
  317.       BottomLine,
  318.       OldTop,
  319.       Current,
  320.       Last,I       : Integer;
  321.       DoAll : Boolean;
  322.   Begin
  323.     If KeyPressed then Repeat
  324.       Read(Kbd,Ch);
  325.     Until NOT Keypressed;
  326.     Current:=1;
  327.     Last:=1;
  328.     TopLine:=1;
  329.     BottomLine:=20;
  330.     If BottomLine>EntryNum then BottomLine:=EntryNum;
  331.     DoAll:=True;
  332.     HideCursor;
  333.     Repeat
  334.       If DoAll then begin
  335.         If Monitortype = 7 then begin
  336.           For I:= 1 to 23 do begin
  337.             GotoXY(1,I);
  338.             Write(ConstStr(' ',13));
  339.           End;
  340.           GotoXY(1,1);
  341.         End Else ClrScr;
  342.         For I:= TopLine to BottomLine do begin
  343.           LowVideo;
  344.           If Entry[I].EStatus=1 then TextColor(1);
  345.           If I=Current then begin
  346.             TextBackGround(7);
  347.             If Entry[I].EStatus=1 then TextColor(1) Else TextColor(0)
  348.           End;
  349.           WriteLn(Entry[I].EName,' ',Entry[I].EExt);
  350.         End;
  351.         OldTop:=TopLine;
  352.       End Else begin
  353.         GotoXY(1,1+(Current-TopLine));
  354.         TextBackGround(7);
  355.         If Entry[Current].EStatus=1 then TextColor(1) Else TextColor(0);
  356.         WriteLn(Entry[Current].EName,' ',Entry[Current].EExt);
  357.         OldTop:=TopLine;
  358.       End;
  359.       LowVideo;
  360.       GotoXY(1,21);ClrEol;
  361.       If BottomLine<EntryNum then Write('  ',#25,' MORE ',#25);
  362.       GotoXY(1,22);
  363.       TextColor(1);
  364.       Write(' Blue ');
  365.       LowVideo;
  366.       Write('= Dup');
  367.       Last:=Current;
  368.       Read(Kbd,Ch);
  369.       If (Ch=#27) and KeyPressed then Read(Kbd,Ch);
  370.       DoAll:=False;
  371.       Case Ch of
  372.         #72 : Current:=Current-1;       { up }
  373.         #80 : Current:=Current+1;       { down }
  374.         #71 : Current:=TopLine;         { home }
  375.         #79 : Current:=BottomLine;      { end }
  376.         #73 : Begin
  377.                 BottomLine:=BottomLine-20;   { pgup }
  378.                 DoAll:=True;
  379.               End;
  380.         #81 : Begin
  381.                 BottomLine:=BottomLine+20;   { pgdn }
  382.                 DoAll:=True;
  383.               End;
  384.         'S','s' : Begin
  385.                     QuickSortRecord(Entry,EntryNum);
  386.                     Current:=1;
  387.                     DoAll:=True;
  388.                   End;
  389.         #13 : ;
  390.       Else Boop;
  391.       End;
  392.       GotoXY(1,1+(Last-TopLine));
  393.       LowVideo;
  394.       If Entry[Last].EStatus=1 then TextColor(1);
  395.       WriteLn(Entry[Last].EName,' ',Entry[Last].EExt);
  396.       GotoXY(1,1);
  397.       If (Current=BottomLine+1) and (Current<=EntryNum) then DelLine;
  398.       If (Current=TopLine-1) and (Current>0) then begin
  399.         InsLine;
  400.         GotoXY(1,21);
  401.         DelLine;
  402.       End;
  403.       If Current<1 then Current:=1;
  404.       If Current>EntryNum then Current:=EntryNum;
  405.       If Current>TopLine+19 then BottomLine:=Current;
  406.       If Current<TopLine then TopLine:=Current;
  407.       If TopLine<>OldTop then BottomLine:=Topline+19;
  408.       If BottomLine<20 then BottomLine:=20;
  409.       If BottomLine>EntryNum then BottomLine:=EntryNum;
  410.       TopLine:=BottomLine-19;
  411.       If TopLine<1 then TopLine:=1;
  412.       If Current<TopLine then Current:=TopLine;
  413.       If Current>BottomLine then Current:=BottomLine;
  414.     Until Ch in [#13,#27,#59];
  415.     RestoreCursor;
  416.     If Ch=#27 then SelectFile:=0
  417.       Else If Ch=#59 then Selectfile:=-1
  418.       Else SelectFile:=Current;
  419.   End; { function SelectFile }
  420.  
  421. OVERLAY PROCEDURE volume(drivelet:Char;AskChange:Boolean);
  422.   TYPE
  423.     extendfcb = ARRAY[0..43] OF Char;
  424.   VAR
  425.     drivenam : STRING[3];
  426.     drive : byte;
  427.     i,filetime,filedate : Integer;
  428.     s : AnyStr;
  429.     haslabel : Boolean;
  430.     labl : string[11];
  431.     dta, xfcb, sfcb : extendfcb;
  432.  
  433.   PROCEDURE initfcb(VAR x : extendfcb; namechar : Char);
  434.     {initialize an extended fcb}
  435.     VAR
  436.       i : Integer;
  437.     BEGIN
  438.       x[0] := Chr(255);     {flag for extended FCB}
  439.       FOR i := 1 TO 5 DO x[i] := Chr(0);
  440.       x[6] := Chr(8);       {specifies that we want volume label}
  441.       x[7] := Chr(0);       {where drive number goes}
  442.       FOR i := 8 TO 18 DO x[i] := namechar;
  443.       FOR i := 19 TO 43 DO x[i] := Chr(0);
  444.     END;                    {initfcb}
  445.  
  446.   BEGIN
  447.     initfcb(sfcb, '?');     {initialize buffers}
  448.     initfcb(xfcb, ' ');
  449.     Drive:=Ord(DriveLet)-64;
  450.     sfcb[7] := Chr(drive);
  451.     xfcb[7] := Chr(drive);
  452.     regs.ax := $1A00;
  453.     regs.ds := Seg(dta[0]);
  454.     regs.dx := Ofs(dta[0]);
  455.     MsDos(regs);             {SET UP DISK TRANSFER AREA FOR FILENAMES}
  456.  
  457.     regs.dx := Ofs(sfcb[0]);
  458.     regs.ax := $1100;
  459.     MsDos(regs);             {search for volume entry}
  460.  
  461.     IF Lo(regs.ax) = $FF THEN BEGIN
  462.       haslabel := False;
  463.       OldVolumeName := '<NONE>';
  464.       OldVolumeNameDate := '';
  465.       GotoXY(1,11); ClrEol;
  466.       WriteLn('Diskette in drive ',drive,' has no label... please enter.');
  467.     END ELSE BEGIN
  468.       haslabel := True;
  469.       OldVolumeName:='';
  470.       FOR i := 1 TO 11 DO OldVolumeName:=OldVolumeName+(dta[7+i]);
  471.       I:=11;
  472.       While (OldVolumeName[I]=' ') and (I>0) do begin
  473.         Delete(OldVolumeName,I,1);
  474.         I:=I-1;
  475.       End;
  476.       filetime:=ord(dta[31]) shl 8 + ord(dta[30]);
  477.       filedate:=ord(dta[33]) shl 8 + ord(dta[32]);
  478.       Month := (FileDate shl 7) shr 12;
  479.       Str(Month,S);
  480.       OldVolumeNameDate := S + '-';
  481.       Day := (FileDate shl 11) shr 11;
  482.       If Day < 10 then OldVolumeNameDate := OldVolumeNameDate + '0';
  483.       Str(Day,S);
  484.       OldVolumeNameDate := OldVolumeNameDate + S + '-';
  485.       Year := (FileDate shr 9) + 80;
  486.       Str(Year,S);
  487.       OldVolumeNameDate := OldVolumeNameDate + S + '  ';
  488.       Hour := FileTime shr 11;
  489.       If Hour >= 12 then begin
  490.         AP := 'p';
  491.         Hour := Hour - 12;
  492.       End Else AP := 'a';
  493.       If Hour = 0 then Hour := 12;
  494.       Str(Hour:2,S);
  495.       OldVolumeNameDate := OldVolumeNameDate + S + ':';
  496.       Minute := (FileTime shl 5) shr 10;
  497.       If Minute < 10 then OldVolumeNameDate := OldVolumeNameDate + '0';
  498.       Str(Minute,S);
  499.       OldVolumeNameDate := OldVolumeNameDate + S + AP;
  500.     END;
  501.     IF (HasLabel=False) or (AskChange) THEN Begin  {go on to change the label}
  502.       Repeat
  503.         Beep;
  504.         GotoXY(30,10);ClrEol;
  505.         ReadLn(labl);
  506.         if (labl='') and (OldVolumeName<>'') then labl:=OldVolumeName;
  507.         OldVolumeName:=labl;
  508.       Until labl<>'';
  509.       IF Length(labl) > 0 THEN BEGIN
  510.         FOR i := 1 TO Length(labl) DO xfcb[7+i] := labl[i]; {insert label into xfcb}
  511.         IF haslabel THEN BEGIN
  512.           FOR i := 1 TO 11 DO dta[23+i] := xfcb[7+i]; {modify dta}
  513.           regs.ds := Seg(dta[0]);
  514.           regs.dx := Ofs(dta[0]);
  515.           regs.ax := $1700;
  516.           MsDos(regs);
  517.         END ELSE BEGIN
  518.           regs.ds := Seg(xfcb[0]);
  519.           regs.dx := Ofs(xfcb[0]);
  520.           regs.ax := $1600;
  521.           MsDos(regs);
  522.         END;
  523.         GotoXY(1,11);ClrEol;
  524.         IF Lo(regs.ax) = $FF THEN begin
  525.           Boop;
  526.           Write('Error in modifying label... press any key.');
  527.           Read(Kbd,Ch);
  528.         End ELSE Write(labl,' successfully created.');
  529.       END;
  530.     End;
  531.   END; {volume}
  532.  
  533. OVERLAY PROCEDURE TestIt;
  534.   VAR I,R,N,MatchCount : Integer;
  535.       S1,S2,S3 : String[14];
  536.       K,K2 : String[6];
  537.   Begin
  538.     SaveScreen;
  539.     PrintCount:=0;
  540.     ClrScr;
  541.     If not PrTest then Repeat
  542.       Beep;
  543.       DrawBox(10,70,16,21);
  544.       BigWindow(11,17,69,20);
  545.       If MonitorType = 7 then begin
  546.         HideCursor;
  547.         For I:=1 to 4 do begin
  548.           GotoXY(1,I);
  549.           Write(ConstStr(' ',59));
  550.         End;
  551.         RestoreCursor;
  552.       End Else ClrScr;
  553.       HideCursor;
  554.       GotoXY(5,2); WriteLn('Printer does not appear to be ready');
  555.       GotoXY(5,3); WriteLn('Press any key when ready or ESC to return to menu');
  556.       Repeat until KeyPressed;
  557.       Read(Kbd,Ch);
  558.       BigWindow(1,1,80,25);
  559.       ClrScr;
  560.       HideCursor;
  561.       If (Ch = #27) and KeyPressed then Read(Kbd,Ch);
  562.       If Ch = #27 then begin
  563.         RestoreScreen;
  564.         Exit;
  565.       End;
  566.     Until PrTest;
  567.     OpenFiles;
  568.     MatchCount:=0;
  569.     For I:=1 to EntryNum do begin
  570.       S1:=Entry[I].EName+Entry[I].EExt;
  571.       WriteLn('Checking ',Entry[I].EName,'.',Entry[I].EExt);
  572.       FKey:=S1;
  573.       ClearKey(CIndex);
  574.       SearchKey(CIndex,R,FKey);
  575.       If OK then Repeat
  576.         S2:=Copy(FKey,1,11);
  577.         If S1=S2 then Begin
  578.           MatchCount:=MatchCount+1;
  579.           If PrintCount=0 then Begin
  580.             WriteLn(Lst,'Listing of duplicate file NAMES found on ',SourceDirectory);
  581.             WriteLn(Lst,ConstStr('-',79));
  582.             WriteLn(Lst);
  583.             PrintCount:=3;
  584.           End;
  585.           GetRec(CFile,R,FileRec);
  586.           S3:=FileRec.FileName;
  587.           Write(Lst,S3,' exists on disk ');
  588.           Write(Lst,FileRec.VolPath,' with same name');
  589.           If (Entry[I].EDate=FileRec.FileDate) and
  590.              (Entry[I].ESize[1]=FileRec.FileSize[1]) and
  591.              (Entry[I].ESize[2]=FileRec.FileSize[2]) and
  592.              (Entry[I].ESize[3]=FileRec.FileSize[3]) and
  593.              (Entry[I].ESize[4]=FileRec.FileSize[4]) then
  594.              WriteLn(Lst,', size and date')
  595.           Else WriteLn(Lst);
  596.           PrintCount:=PrintCount+1;
  597.           If PrintCount >=55 then begin
  598.             Write(Lst,#12);
  599.             PrintCount:=0;
  600.           End;
  601.         End;
  602.         NextKey(CIndex,R,FKey);
  603.         S2:=Copy(FKey,1,11);
  604.       Until S1<>S2;
  605.     End;
  606.     ClrScr;
  607.     GotoXY(30,10);
  608.     Beep;
  609.     WriteLn(MatchCount,' matches found.');
  610.     If MatchCount>0 then begin
  611.       WriteLn(Lst);
  612.       WriteLn(Lst,MatchCount,' matches found.');
  613.       MatchCount:=0;
  614.     End;
  615.     If PrintCount>0 then Write(Lst,#12);
  616.     PrintCount:=0;
  617.     GotoXY(8,12);
  618.     Write('Do you also wish to check for possible Date/Size duplicates?  Y/N');
  619.     If Yes then begin
  620.       ClrScr;
  621.       CloseIndex(CIndex);
  622.       If NOT (Exist('FILECAT.TMP')) then begin
  623.         Write('Please wait... building new index:');
  624.         MakeIndex(CIndex,'FILECAT.TMP',6,1);
  625.         HideCursor;
  626.         For N := 1 to FileLen(CFile)-1 do begin
  627.           GetRec(CFile,N,FTemp);
  628.           If FTemp.Status=0 then begin
  629.             GotoXY(37,WhereY);ClrEol;
  630.             Write(N);
  631.             K:='      ';
  632.             For I:= 1 to 4 do K[I]:=Chr(Ord(FTemp.FileSize[I]));
  633.             K[5]:=Chr(Hi(FTemp.FileDate));
  634.             K[6]:=Chr(Lo(FTemp.FileDate));
  635.             AddKey(CIndex,N,K);
  636.           End;
  637.         End;
  638.         RestoreCursor;
  639.         WriteLn;
  640.       End Else OpenIndex(CIndex,'FILECAT.TMP',6,1);
  641.       For I:=1 to EntryNum do begin
  642.         K2:='      ';
  643.         For R:= 1 to 4 do K2[R]:=Chr(Ord(Entry[I].ESize[R]));
  644.         K2[5]:=Chr(Hi(Entry[I].EDate));
  645.         K2[6]:=Chr(Lo(Entry[I].EDate));
  646.         WriteLn('Checking ',Entry[I].EName,'.',Entry[I].EExt);
  647.         FKey:=K2;
  648.         ClearKey(CIndex);
  649.         FindKey(CIndex,R,K2);
  650.         If OK then Begin
  651.           MatchCount:=MatchCount+1;
  652.           If PrintCount=0 then Begin
  653.             WriteLn(Lst,'Listing of duplicate file SIZE/DATEs found on ',SourceDirectory);
  654.             WriteLn(Lst,ConstStr('-',79));
  655.             WriteLn(Lst);
  656.             PrintCount:=3;
  657.           End;
  658.           GetRec(CFile,R,FTemp);
  659.           Write(Lst,Entry[I].EName,'.',Entry[I].EExt);
  660.           Write(Lst,' has same date and size as ',FTemp.FileName);
  661.           WriteLn(Lst,' on disk ',FTemp.VolPath);
  662.           PrintCount:=PrintCount+1;
  663.           If PrintCount >=55 then begin
  664.             Write(Lst,#12);
  665.             PrintCount:=0;
  666.           End;
  667.           Repeat
  668.             NextKey(CIndex,R,K2);
  669.             If (FKey=K2) and OK then begin
  670.               MatchCount:=MatchCount+1;
  671.               If PrintCount=0 then Begin
  672.                 WriteLn(Lst,'Duplicate file SIZE/DATEs found on ',SourceDirectory,' on ',TDate);
  673.                 WriteLn(Lst,ConstStr('-',79));
  674.                 WriteLn(Lst);
  675.                 PrintCount:=3;
  676.               End;
  677.               GetRec(CFile,R,FTemp);
  678.               Write(Lst,Entry[I].EName,'.',Entry[I].EExt);
  679.               Write(Lst,' has same date and size as ',FTemp.FileName);
  680.               WriteLn(Lst,' on disk ',FTemp.VolPath);
  681.               PrintCount:=PrintCount+1;
  682.               If PrintCount >=55 then begin
  683.                 Write(Lst,#12);
  684.                 PrintCount:=0;
  685.               End;
  686.             End;
  687.           Until (K2<>FKey) or (NOT OK);
  688.         End;
  689.       End;
  690.       If MatchCount>0 then begin
  691.         WriteLn(Lst);
  692.         WriteLn(Lst,MatchCount,' matches found.');
  693.         MatchCount:=0;
  694.       End;
  695.       If PrintCount>0 then Write(Lst,#12);
  696.     End;
  697.     PrintCount:=0;
  698.     RestoreScreen;
  699.     RestoreCursor;
  700.     CloseFiles;
  701.   End; { procedure TestIt }
  702.  
  703. OVERLAY PROCEDURE TestIt2;
  704.   VAR I,R,N,MatchCount : Integer;
  705.       S1,S2,S3 : String[14];
  706.       K,K2 : String[6];
  707.   Begin
  708.     SaveScreen;
  709.     PrintCount:=0;
  710.     ClrScr;
  711.     If not PrTest then Repeat
  712.       Beep;
  713.       DrawBox(10,70,16,21);
  714.       BigWindow(11,17,69,20);
  715.       If MonitorType = 7 then begin
  716.         HideCursor;
  717.         For I:=1 to 4 do begin
  718.           GotoXY(1,I);
  719.           Write(ConstStr(' ',59));
  720.         End;
  721.         RestoreCursor;
  722.       End Else ClrScr;
  723.       HideCursor;
  724.       GotoXY(5,2); WriteLn('Printer does not appear to be ready');
  725.       GotoXY(5,3); WriteLn('Press any key when ready or ESC to return to menu');
  726.       Repeat until KeyPressed;
  727.       Read(Kbd,Ch);
  728.       BigWindow(1,1,80,25);
  729.       ClrScr;
  730.       HideCursor;
  731.       If (Ch = #27) and KeyPressed then Read(Kbd,Ch);
  732.       If Ch = #27 then begin
  733.         RestoreScreen;
  734.         Exit;
  735.       End;
  736.     Until PrTest;
  737.     OpenFiles;
  738.     MatchCount:=0;
  739.     FKey:='';
  740.     ClearKey(CIndex);
  741.     SearchKey(CIndex,R,FKey);
  742.     N:=R;
  743.     S1:=Copy(FKey,1,11);
  744.     While OK do begin
  745.       WriteLn('Checking ',S1);
  746.       NextKey(CIndex,R,FKey);
  747.       S2:=Copy(FKey,1,11);
  748.       If (S1=S2) and OK then Begin
  749.         GetRec(CFile,N,FTemp);
  750.         GetRec(CFile,R,FileRec);
  751.         MatchCount:=MatchCount+1;
  752.         If PrintCount=0 then Begin
  753.           WriteLn(Lst,'Listing of duplicate file NAMES found in FILECAT database on ',TDate);
  754.           WriteLn(Lst,ConstStr('-',79));
  755.           WriteLn(Lst);
  756.           PrintCount:=3;
  757.         End;
  758.         Write(Lst,FTemp.FileName,' on ',FTemp.VolPath,' same as ');
  759.         WriteLn(Lst,FileRec.FileName,' on ',FileRec.VolPath);
  760.         PrintCount:=PrintCount+1;
  761.         If PrintCount >=55 then begin
  762.           Write(Lst,#12);
  763.           PrintCount:=0;
  764.         End;
  765.       End;
  766.       S1:=S2;
  767.       N:=R;
  768.     End;;
  769.     ClrScr;
  770.     GotoXY(22,10);
  771.     Beep;
  772.     WriteLn(MatchCount,' matches found... press any key.');
  773.     Read(Kbd,Ch);
  774.     If MatchCount>0 then begin
  775.       WriteLn(Lst);
  776.       WriteLn(Lst,MatchCount,' matches found.');
  777.       MatchCount:=0;
  778.     End;
  779.     If PrintCount>0 then Write(Lst,#12);
  780.     PrintCount:=0;
  781.     RestoreCursor;
  782.     RestoreScreen;
  783.     CloseFiles;
  784.   End; { procedure TestIt2 }
  785.  
  786. OVERLAY PROCEDURE InitializeFiles;
  787.   VAR I:Integer;
  788.   Begin
  789.     ChDir(EntryDirectory);
  790.     OpenFile(CFile,'FILECAT.DAT',SizeOf(FRec));
  791.     If OK then OpenIndex(CIndex,'FILECAT.IXN',14,1);
  792.     If NOT OK then begin
  793.       Beep;
  794.       GotoXY(5,25);
  795.       Write('Files not found.  Creating new files.');
  796.       MakeFile(CFile,'FILECAT.DAT',SizeOf(FRec));
  797.       MakeIndex(CIndex,'FILECAT.IXN',14,1);
  798.     End;
  799.     CloseFile(CFile);
  800.     CloseIndex(CIndex);
  801.     OpenIndex(KIndex,'FILECAT.KWD',15,0);
  802.     If NOT OK then MakeIndex(KIndex,'FILECAT.KWD',15,0);
  803.     CloseIndex(KIndex);
  804.     GotoXY(1,25);ClrEol;
  805.     InitFiles:=True;
  806.   End; { procedure InitializeFiles }
  807.  
  808. OVERLAY PROCEDURE Goodbye;
  809.   Begin
  810.     GotoXY(1,1);
  811.     WriteLn('Thank you for using FILECAT');
  812.     WriteLn;
  813.     WriteLn('PLEASE back up your data disk on a regular basis...');
  814.     WriteLn('It will just take a couple of minutes, and will help prevent disaster.');
  815.     WriteLn;
  816.     WriteLn('Floppy Disk Users: Put your working data disk in A, backup disk in B.');
  817.     WriteLn('                   Type "COPY A:*.* B:" and return.');
  818.     WriteLn;
  819.     WriteLn('  Hard Disk Users: Change into your FILECAT subdirectory.');
  820.     WriteLn('                   Put your backup disk in drive A.');
  821.     WriteLn('                   Type "COPY *.*  A:"');
  822.     WriteLn;
  823.     WriteLn('Enjoy... Kenn Flee');
  824.   End; { procedure Goodbye }
  825.